home *** CD-ROM | disk | FTP | other *** search
/ MacHack 2001 / MacHack 2001.toast / pc / The Hacks / 99 Bottles hack / MyUtils / Assertions.p next >
Encoding:
Text File  |  2001-06-23  |  3.9 KB  |  191 lines

  1. unit Assertions;
  2.  
  3. interface
  4.  
  5. {$IFC MACTARGET}
  6.     uses
  7.         Types, Dialogs, Processes, TextUtils;
  8. {$ENDC}
  9.  
  10. {$IFC WINTARGET}
  11.     uses
  12.         MyWinUtils;
  13. {$ENDC}
  14.  
  15.  
  16.     const
  17.         DEBUG_ALERT_ID = 24576; { debugging alert, must be included in resource file with the }
  18. { following items: 1 to continue, 2 to terminate and at least one StaticText with ^1 for}
  19. { the message string. }
  20.  
  21. { Useful compile-time variables }
  22.  
  23. {$ifc undefined PROGICIEL_R_4}
  24. {$setc PROGICIEL_R_4 := true}
  25. {$endc}
  26.  
  27. { Use threads or not? }
  28. { Threads are broken under Think Pascal 4.02 }
  29. {$setc can_use_threads := true}
  30. {$ifc THINK_PASCAL}
  31. {$setc can_use_threads := false}
  32. {$endc}
  33.  
  34. {$ifc undefined do_debug}
  35. {$setc do_debug := 1}
  36. {$endc}
  37.  
  38. {$ifc undefined do_showmem}
  39. {$setc do_showmem := 1}
  40. {$endc}
  41.  
  42. {$ifc undefined do_debugfiles}
  43. {$setc do_debugfiles := 1}
  44. {$endc}
  45.  
  46. {$setc do_showmem := 0}
  47. {$setc do_debugfiles := 0}
  48.  
  49.  
  50. {$IFC MACTARGET}
  51.  
  52. {$ifc not do_debug}
  53. { Do this only under THINK Pascal, since it's linked out in CW with the definec }
  54. {$IFC THINK_PASCAL}
  55.     procedure Assert (b: Boolean);
  56. {$endc}
  57. {$definec Assert(b)}
  58. {$elsec}
  59. {$definec Assert(b) AssertCode(b, SrcLine, SrcFile, CompDate, CompTime)}
  60. {$DEFINEC passert(a) lassert(a,srcfile,srcline)}
  61. {$endc}
  62.  
  63. {$ifc do_debug}
  64.  
  65. {$ifc do_debugfiles}
  66.     var
  67.         debug1, debug2: Text;
  68. {$endc}
  69.  
  70. {$IFC THINK_PASCAL}
  71.     procedure Assert (b: boolean);
  72. {$ELSEC}
  73.     procedure AssertCode (b: boolean; lineNum: LongInt; fileName, cDate, cTime: Str255);
  74. {$ENDC}
  75.  
  76. {$endc}
  77.  
  78. {$ENDC}
  79.  
  80. {$IFC WINTARGET}
  81.     procedure Assert (b: Boolean);
  82. {$ENDC}
  83.  
  84.     procedure MyDebugStr (msg: Str255);
  85.  
  86. implementation
  87.  
  88. {$IFC MACTARGET}
  89.  
  90. {     How to tell if MacsBug is Installed }
  91. {     This is a small snippet of code that can be used to to detect if }
  92. {     macsbug is installed or not. NOTE:  This code is intended to only work with }
  93. {     version 6.2 of macsbug.  You should refer to your Low Level Debugger's manual }
  94. {     for more information on how they install themselves. }
  95. {  }
  96. {     This code is based on information obtained from the MacsBug Reference. }
  97. {     The basic assumptions are that macsbug will install itself in the following }
  98. {     manner: }
  99. {  }
  100. {     If you are running in 24 bit mode, then the high -order byte of MacJmp is a flags }
  101. {     byte that contains the following information: }
  102. {     appears at location 0xBFF.  The code reflects these findings. }
  103.  
  104.  
  105.     function MacsBugInstalled: Boolean;
  106.         const
  107.             BYTEMASK = $20;   { Used to detect if bit 5 is set }
  108.         var
  109.             FlagByte: Ptr;
  110.     begin
  111.         FlagByte := Ptr($BFF);   { This is used only if running in 32 bit mode }
  112.  
  113.         MacsBugInstalled := (BAnd(LongInt(FlagByte^), BYTEMASK) > 0);
  114.     end;
  115.  
  116.  
  117. {$ifc do_debug}
  118. {$IFC THINK_PASCAL}
  119.     procedure Assert;
  120. {$ELSEC}
  121.         procedure AssertCode;
  122. {$ENDC}
  123.             var
  124.                 dbgStr: Str255;
  125. {$IFC NOT THINK_PASCAL}
  126.                 lineStr: Str255;
  127. {$ENDC}
  128.         begin
  129.             if not b then begin
  130.                 dbgStr := 'Assertion failed';
  131. {$IFC NOT THINK_PASCAL}
  132.                 NumToString(lineNum, lineStr);
  133.                 dbgStr := Concat(dbgStr, ' in file ', fileName, ', line: ', lineStr, ' (', cDate, ' at ', cTime, ')');
  134. {$ENDC}
  135.                 dbgStr := Concat(dbgStr, '. Notify casgrain@magellan.umontreal.ca');
  136.                 MyDebugStr(dbgStr);
  137.             end;
  138.         end;
  139. {$elsec}
  140. { Do this only under THINK Pascal, since it's linked out in CW }
  141. {$IFC THINK_PASCAL}
  142.         procedure Assert;
  143.         begin
  144.         end;
  145. {$endc}
  146. {$endc}
  147.  
  148. { this procedure displays an alert when debugging is not enabled }
  149. { it allows to exit the program (losing everything but hopefully not }
  150. { hosing the system) or continue along. }
  151.         procedure DisplayDebugStr (msg: Str255);
  152.         begin
  153.             ParamText(msg, '', '', '');
  154.             if StopAlert(DEBUG_ALERT_ID, nil) = cancel then
  155.                 ExitToShell;
  156.         end;
  157.  
  158.         procedure MyDebugStr (msg: Str255);
  159. {$ifc do_debug}
  160.         begin
  161.             if MacsBugInstalled then begin
  162.                 msg := Concat(msg, ';sc;hc');
  163.                 DebugStr(msg);
  164.             end
  165.             else
  166.                 DisplayDebugStr(msg);
  167.         end;
  168. {$elsec}
  169.     begin
  170.         DisplayDebugStr(msg);
  171.     end;
  172. {$endc}
  173.  
  174. {$ENDC}
  175.  
  176. {$IFC WINTARGET}
  177.  
  178.     procedure Assert;
  179.     begin
  180.  
  181.     end;
  182.  
  183.     procedure MyDebugStr;
  184.     begin
  185.  
  186.     end;
  187.  
  188. {$ENDC}
  189.  
  190.  
  191. end.